home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH1 / SRC / RUBBRBOX.FRM < prev    next >
Text File  |  1995-12-15  |  3KB  |  115 lines
  1. VERSION 4.00
  2. Begin VB.Form RubberForm 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Rubberband Boxes"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   1140
  7.    ClientTop       =   1800
  8.    ClientWidth     =   6690
  9.    Height          =   4830
  10.    Left            =   1080
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4140
  13.    ScaleWidth      =   6690
  14.    Top             =   1170
  15.    Width           =   6810
  16.    Begin VB.Menu mnuFile 
  17.       Caption         =   "&File"
  18.       Begin VB.Menu mnuFileExit 
  19.          Caption         =   "E&xit"
  20.       End
  21.    End
  22. End
  23. Attribute VB_Name = "RubberForm"
  24. Attribute VB_Creatable = False
  25. Attribute VB_Exposed = False
  26. Option Explicit
  27.  
  28. Dim Rubberbanding As Boolean
  29. Dim OldMode As Integer
  30. Dim OldStyle As Integer
  31. Dim FirstX As Single
  32. Dim FirstY As Single
  33. Dim LastX As Single
  34. Dim LastY As Single
  35.  
  36. ' ***********************************************
  37. ' Start rubberbanding.
  38. ' ***********************************************
  39. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  40.     ' Let MouseMove know we are rubberbanding.
  41.     Rubberbanding = True
  42.     
  43.     ' Save values so we can restore them later.
  44.     OldMode = DrawMode
  45.     OldStyle = DrawStyle
  46.     DrawMode = vbInvert
  47.     DrawStyle = vbDot
  48.  
  49.     ' Save the starting coordinates.
  50.     FirstX = X
  51.     FirstY = Y
  52.     
  53.     ' Draw the initial rubberband box.
  54.     LastX = X
  55.     LastY = Y
  56.     Line (FirstX, FirstY)-(LastX, LastY), , B
  57. End Sub
  58.  
  59.  
  60. ' ***********************************************
  61. ' Continue rubberbanding.
  62. ' ***********************************************
  63. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  64.     ' If we are not rubberbanding, do nothing.
  65.     If Not Rubberbanding Then Exit Sub
  66.     
  67.     ' Erase the previous rubberband box.
  68.     Line (FirstX, FirstY)-(LastX, LastY), , B
  69.  
  70.     ' Draw the new rubberband box.
  71.     LastX = X
  72.     LastY = Y
  73.     Line (FirstX, FirstY)-(LastX, LastY), , B
  74. End Sub
  75.  
  76.  
  77. ' ***********************************************
  78. ' Stop rubberbanding.
  79. ' ***********************************************
  80. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  81. Dim oldfill As Integer
  82. Dim oldcolor As Long
  83.  
  84.     ' If we are not rubberbanding, do nothing.
  85.     If Not Rubberbanding Then Exit Sub
  86.     
  87.     ' We are no longer rubberbanding.
  88.     Rubberbanding = False
  89.     
  90.     ' Erase the previous rubberband box.
  91.     Line (FirstX, FirstY)-(LastX, LastY), , B
  92.     
  93.     ' Restore the original DrawMode and DrawStyle.
  94.     DrawMode = OldMode
  95.     DrawStyle = OldStyle
  96.  
  97.     ' Fill the final box with a random color.
  98.     oldfill = FillStyle
  99.     oldcolor = FillColor
  100.     FillStyle = vbSolid
  101.     FillColor = QBColor(Int(Rnd * 16))
  102.  
  103.     Line (FirstX, FirstY)-(LastX, LastY), , B
  104.     
  105.     FillStyle = oldfill
  106.     FillColor = oldcolor
  107. End Sub
  108.  
  109.  
  110. Private Sub mnuFileExit_Click()
  111.     Unload Me
  112. End Sub
  113.  
  114.  
  115.